home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / pcscheme / geneva / sources.exe / SOURCES / C / INPUT.C < prev    next >
Encoding:
C/C++ Source or Header  |  1993-11-11  |  24.0 KB  |  953 lines
  1. /* INPUT.C
  2.  ************************************************************************
  3.  *                                    *
  4.  *        PC Scheme/Geneva 4.00 Borland C code            *
  5.  *                                    *
  6.  * (c) 1985-1988 by Texas Instruments, Inc. See COPYRIGHT.TXT        *
  7.  * (c) 1992 by L. Bartholdi & M. Vuilleumier, University of Geneva    *
  8.  *                                    *
  9.  *----------------------------------------------------------------------*
  10.  *                                    *
  11.  *              PC-Scheme port input routines            *
  12.  *                                    *
  13.  *----------------------------------------------------------------------*
  14.  *                                    *
  15.  * Created by: Marc Vuilleumier        Date: Jan 1993            *
  16.  * Revision history:                            *
  17.  * - 18 Jun 92:    Renaissance (Borland Compilers, ...)            *
  18.  *                                    *
  19.  *                    ``In nomine omnipotentii dei''    *
  20.  ************************************************************************/
  21.  
  22. #include    "scheme.h"
  23. #include    <dos.h>
  24. #include    <conio.h>
  25. #include    <string.h>
  26. #include    <alloc.h>
  27. #include    <mem.h>
  28.  
  29. #define    HISTSIZE    (4 * BUFFSIZE)
  30.  
  31. #define CTRL_A    1
  32. #define CTRL_B  2
  33. #define CTRL_C    3
  34. #define CTRL_D    4
  35. #define CTRL_E    5
  36. #define CTRL_F    6
  37. #define CTRL_G    7
  38. #define CTRL_H    8
  39. #define CTRL_I    9
  40. #define CTRL_J    10
  41. #define CTRL_K    11
  42. #define CTRL_L    12
  43. #define CTRL_M    13
  44. #define CTRL_N    14
  45. #define CTRL_O    15
  46. #define CTRL_P    16
  47. #define CTRL_Q    17
  48. #define CTRL_R    18
  49. #define CTRL_S    19
  50. #define CTRL_T    20
  51. #define CTRL_U    21
  52. #define CTRL_V    22
  53. #define CTRL_W    23
  54. #define CTRL_X    24
  55. #define CTRL_Y    25
  56. #define ALT_A    (30*0x100)
  57. #define ALT_B    (48*0x100)
  58. #define ALT_C    (46*0x100)
  59. #define ALT_D    (32*0x100)
  60. #define ALT_E    (18*0x100)
  61. #define ALT_F    (33*0x100)
  62. #define ALT_G    (34*0x100)
  63. #define ALT_H    (35*0x100)
  64. #define ALT_I    (23*0x100)
  65. #define ALT_J    (36*0x100)
  66. #define ALT_K    (37*0x100)
  67. #define ALT_L    (38*0x100)
  68. #define ALT_M    (50*0x100)
  69. #define ALT_N    (49*0x100)
  70. #define ALT_O    (24*0x100)
  71. #define ALT_P    (25*0x100)
  72. #define ALT_Q    (16*0x100)
  73. #define ALT_R    (19*0x100)
  74. #define ALT_S    (31*0x100)
  75. #define ALT_T    (20*0x100)
  76. #define ALT_U    (22*0x100)
  77. #define ALT_V    (47*0x100)
  78. #define ALT_W    (17*0x100)
  79. #define ALT_X    (45*0x100)
  80. #define ALT_Y    (21*0x100)
  81. #define ALT_Z    (44*0x100)
  82.  
  83. unsigned char    history[HISTSIZE];        /* history buffer */
  84. unsigned char    *histend = history, *histpos;
  85.  
  86. /************************************************************************/
  87. /*    Reads a specified number of chars from file or string        */
  88. /*    Return codes are:    0    data read ok            */
  89. /*                1    end-of-file encountred        */
  90. /*                2    error (use _doserrno)        */
  91. /************************************************************************/
  92. int    read_block( REGPTR port, char *buffer, int length )
  93. {
  94.     return 0;
  95. }
  96.  
  97. /************************************************************************/
  98. /*    tell if a char is available from input buffer             */
  99. /*    (possibly get some chars into buffer, when possible)        */
  100. /************************************************************************/
  101. int    from_buffer( REGPTR port)
  102. {
  103.     return 0;
  104. }
  105.  
  106. /************************************************************************/
  107. /*    tell if a char can be obtained from a port (if yes, which)    */
  108. /*                         (interpreter support)    */
  109. /************************************************************************/
  110. int    port_char_ready( REGPTR port )
  111. {
  112.     PORT    far    *p;
  113.     char        ch;
  114.  
  115.     if( get_port(port, INPUT_PORT) )
  116.     {
  117.         set_src_error("CHAR-READY?", 1, port);
  118.         return    -1;
  119.     } else
  120.         *port =    tmp_reg;
  121.  
  122.     if( from_buffer( port ) ) {
  123.         p = ®2c(port)->port;
  124.         ch = p->buffer[ p->bufpos ];
  125.     } else {
  126.         p = ®2c(port)->port;
  127.         switch( p->flags & PORT_TYPE ) {
  128.             case TYPE_WINDOW:
  129.             case TYPE_SOFTWARE:
  130.             {
  131.                 int    CH = GETCHready();
  132.                 if( !CH ) {
  133.                     *port = nil_reg;
  134.                     return 0;
  135.                 }
  136.                 ch = CH & 0xff;
  137.                 break;
  138.             }
  139.             default:
  140.                 if( !(p->flags & READ_OPEN) ) {
  141.                     *port = nil_reg;
  142.                     return 0;
  143.                 }
  144.                 switch( read_block( port, &ch, 1 ) ) {
  145.                     case 1:
  146.                         port->page = ADJPAGE(EOF_PAGE);
  147.                         port->disp = EOF_DISP;
  148.                         return 0;
  149.                     case 2:
  150.                         /* signal dos error _doserrno */
  151.                         return -1;
  152.                 }
  153.                 p = ®2c(port)->port;
  154.                 p->bufpos = 0;
  155.                 p->bufend = 1;
  156.                 p->buffer[1] = ch;
  157.                 break;
  158.         }
  159.     }
  160.     port->page = SPECCHAR;
  161.     port->disp = ch;
  162.  
  163.     return 0;
  164. }
  165.  
  166.  
  167. /************************************************************************/
  168. /*    read a char from a specified port and push it back into buffer    */
  169. /*                         (interpreter support)    */
  170. /************************************************************************/
  171. int    port_peek_char( REGPTR port )
  172. {
  173.     PORT    far    *p;
  174.     char        ch;
  175.  
  176.     if( get_port(port, INPUT_PORT) )
  177.     {
  178.         set_src_error("CHAR-READY?", 1, port);
  179.         return    -1;
  180.     } else
  181.         *port =    tmp_reg;
  182.  
  183.     if( from_buffer( port ) ) {
  184.         p = ®2c(port)->port;
  185.         ch = p->buffer[ p->bufpos ];
  186.     } else {
  187.         p = ®2c(port)->port;
  188.      }
  189.  
  190.     return 0;
  191. }
  192.  
  193. /************************************************************************/
  194. /*    read a char from a specified port and forward pointer        */
  195. /*                         (interpreter support)    */
  196. /************************************************************************/
  197. int    port_read_char( REGPTR port )
  198. {
  199.     PORT    far    *p;
  200.     char        ch;
  201.  
  202.     if( get_port(port, INPUT_PORT) )
  203.     {
  204.         set_src_error("CHAR-READY?", 1, port);
  205.         return    -1;
  206.     } else
  207.         *port =    tmp_reg;
  208.  
  209.     if( from_buffer( port ) ) {
  210.         p = ®2c(port)->port;
  211.         ch = p->buffer[ p->bufpos ];
  212.     } else {
  213.         p = ®2c(port)->port;
  214.      }
  215.  
  216.     return 0;
  217. }
  218.  
  219.  
  220. /************************************************************************/
  221. /*    read a line from a specified port and forward pointer        */
  222. /*                         (interpreter support)    */
  223. /************************************************************************/
  224. int    port_read_line( REGPTR port )
  225. {
  226.     PORT    far    *p;
  227.     char        ch;
  228.  
  229.     if( get_port(port, INPUT_PORT) )
  230.     {
  231.         set_src_error("CHAR-READY?", 1, port);
  232.         return    -1;
  233.     } else
  234.         *port =    tmp_reg;
  235.  
  236.     if( from_buffer( port ) ) {
  237.         p = ®2c(port)->port;
  238.         ch = p->buffer[ p->bufpos ];
  239.     } else {
  240.         p = ®2c(port)->port;
  241.      }
  242.  
  243.     return 0;
  244. }
  245.  
  246.  
  247. /************************************************************************/
  248. /*    read_win local support: Rewrite a line of text from buffer    */
  249. /************************************************************************/
  250. void    rewrite( int line, int backward )
  251. {
  252.     PORT        far    *p;
  253.     unsigned char    far    *c;
  254.     int        col;
  255.     
  256.     p = ®2c(&port_reg)->port;    /* reload port page */
  257.     c = &p->buffer[index];
  258.     col = curcol;
  259.     if ( !backward ) {
  260.         while ( *c != CR && col < ncols )
  261.             zputc(    ulline + line, ulcol + col++,
  262.                       (t_attrib << 8) + *(c++), 
  263.                 1, &vidmode );
  264.     } else {
  265.         unsigned    ref = FP_OFF(p->buffer);
  266.  
  267.         while ( FP_OFF(c) >= ref && col >= 0 )
  268.             zputc(    ulline + line, ulcol + col--,
  269.                       (t_attrib << 8) + *(c--), 
  270.                 1, &vidmode );
  271.     }
  272. }
  273.  
  274. /************************************************************************/
  275. /*    read_win local support: Fit current pos within window bounds    */
  276. /************************************************************************/
  277. void    checkbounds( void )
  278. {
  279.     if ( curcol < 0 ) curcol = ncols - 1, curline--;
  280.     else    if ( curcol >= ncols ) curcol = 0, curline++;
  281.  
  282.     if ( curline < 0 ) {
  283.         zscroll_d( ulline, ulcol, nlines, ncols, t_attrib );
  284.         rewrite( 0, 1 );
  285.         curline = 0;
  286.     } else
  287.         if ( curline >= nlines ) {
  288.             zscroll( ulline, ulcol, nlines, ncols, t_attrib );
  289.             rewrite( curline = nlines - 1, 0 );
  290.         }
  291. }
  292.     
  293. /************************************************************************/
  294. /*    read_win local support: Update window with buffer contents    */
  295. /************************************************************************/
  296. void    updatewin( void )
  297. {
  298.     PORT    far    *p;
  299.     int    pos = index, line = curline, col = curcol;
  300.     
  301.     p = ®2c(&port_reg)->port;    /* reload port page */
  302.  
  303.     while ( p->buffer[index] != CR && (curcol != ncols || curline != nlines-1) ) {
  304.         checkbounds();
  305.         zputc( ulline + curline, ulcol + (curcol++),
  306.             (t_attrib << 8) + p->buffer[index++], 1, &vidmode );
  307.     }
  308.  
  309.     curcol = col, curline = line, index = pos;
  310. }
  311.  
  312. /************************************************************************/
  313. /*    read_win local support: Tells if arg is a Scheme separator    */
  314. /************************************************************************/
  315. int    is_separator( unsigned char c )
  316. {
  317.     return    c == '"' || (c >= '\'' && c <= ')') ||
  318.         c == '`' || c == ' ' || c == '\t' || c == '\r';
  319. }
  320.  
  321. /************************************************************************/
  322. /*    read_win local support: goes to word left to cursor        */
  323. /************************************************************************/
  324. void    wordleft( void )
  325. {
  326.     PORT    far    *p;
  327.     
  328.     p = ®2c(&port_reg)->port;    /* reload port page */
  329.  
  330.     while ( index > 0 && is_separator( p->buffer[index-1] ) ) {
  331.         index--, curcol--;
  332.         checkbounds();
  333.     }
  334.     while ( index > 0 && !is_separator( p->buffer[index-1] ) ) {
  335.         index--, curcol--;
  336.         checkbounds();
  337.     }
  338. }
  339.  
  340. /************************************************************************/
  341. /*    read_win local support: goes to word right to cursor        */
  342. /************************************************************************/
  343. void    wordright( void )
  344. {
  345.     PORT    far    *p;
  346.     
  347.     p = ®2c(&port_reg)->port;    /* reload port page */
  348.  
  349.     while ( !is_separator( p->buffer[index] ) ) {
  350.         index++, curcol++;
  351.         checkbounds();
  352.     }
  353.     while ( p->buffer[index] != CR && is_separator( p->buffer[index] ) ) {
  354.         index++, curcol++;
  355.         checkbounds();
  356.     }
  357. }
  358.  
  359. /************************************************************************/
  360. /*    read_win local support: goes to end of buffer            */
  361. /************************************************************************/
  362. void    endkey( void )
  363. {
  364.     PORT    far    *p;
  365.     
  366.     p = ®2c(&port_reg)->port;    /* reload port page */
  367.  
  368.     while ( p->buffer[index] != CR ) {
  369.         index++, curcol++;
  370.         checkbounds();
  371.     }
  372. }
  373.  
  374. /************************************************************************/
  375. /*    read_win local support: goes to beginning of buffer        */
  376. /************************************************************************/
  377. void    homekey( void )
  378. {
  379.     while ( index != 0 ) {
  380.         index--, curcol--;
  381.         checkbounds();
  382.     }
  383. }
  384.  
  385. /************************************************************************/
  386. /*    read_win local support: Put a single char into buffer        */
  387. /************************************************************************/
  388. void    putkey( unsigned char c )
  389. {
  390.     PORT    far    *p;
  391.     int        len;
  392.     
  393.     p = ®2c(&port_reg)->port;    /* reload port page */
  394.  
  395.     if ( insert_m || p->buffer[index] == CR ) {
  396.         len = FP_OFF(_fstrchr( &p->buffer[index], CR )) - FP_OFF(p->buffer) + 1;
  397.         if ( len < BUFFSIZE-2 )
  398.             _fmemmove( &p->buffer[index+1], &p->buffer[index], len-index );
  399.         else {
  400.             zbell();
  401.             return;
  402.         }
  403.         p->buffer[index] = c;
  404.         updatewin();
  405.         index++, curcol++;
  406.     } else {
  407.         p->buffer[index] = c;
  408.         zputc( ulline + curline, ulcol + (curcol++),
  409.             (t_attrib << 8) + p->buffer[index++], 1, &vidmode );
  410.     }
  411. }
  412.  
  413. /************************************************************************/
  414. /*    read_win local support: remove a single char from buffer    */
  415. /************************************************************************/
  416. void    delkey( void )
  417. {
  418.     PORT    far    *p;
  419.     int        len;
  420.     
  421.     p = ®2c(&port_reg)->port;    /* reload port page */
  422.  
  423.     len = FP_OFF(_fstrchr( &p->buffer[index], CR )) - FP_OFF(p->buffer);
  424.     _fmemmove( &p->buffer[index], &p->buffer[index+1], len-index );
  425.     p->buffer[--len] = SPACE;
  426.     updatewin();
  427.     p->buffer[len] = CR;
  428. }
  429.  
  430. /************************************************************************/
  431. /*    read_win local support: backdel buffer until given index    */
  432. /************************************************************************/
  433. void    backdelto( int stop )
  434. {
  435.     while ( index > stop ) {
  436.         index--, curcol--;
  437.         checkbounds();
  438.         delkey();
  439.     }
  440. }
  441.  
  442. /************************************************************************/
  443. /*    read_win local support: insert a part of a string into history    */
  444. /*        also used for %push-history opcode            */
  445. /************************************************************************/
  446. void    inhistory( unsigned char far *txt, int len )
  447. {
  448.     if ( histend - history > HISTSIZE - len - 1) {
  449.         history[HISTSIZE - len - 1] = 0; /* put end of string */
  450.         histend = strrchr( history, CR ) + 1;
  451.         if ( histpos > histend ) histpos = histend;
  452.     }
  453.     memmove( &history[len + 1], history, histend - history );
  454.     _fmemmove( history, txt, len );
  455.     history[len] = CR;
  456.     histend += len + 1;
  457.     histpos += len + 1;
  458. }
  459.  
  460. /************************************************************************/
  461. /*    read_win local support: insert chars from history into buffer    */
  462. /************************************************************************/
  463. void    fromhistory( void )
  464. {
  465.     while ( histpos < histend && *histpos != CR ) {
  466.         putkey( *histpos++ );
  467.         checkbounds();
  468.     }
  469.     if ( histpos < histend ) histpos++;
  470. }
  471.  
  472. /************************************************************************/
  473. /*    read_win local support: scan history to more old entry        */
  474. /*        also used for %get-history opcode            */
  475. /************************************************************************/
  476. void    scanhistoryfwd( void )
  477. {
  478.     unsigned char    *found = strchr(histpos, CR);
  479.  
  480.     if ( found ) histpos = found + 1;
  481. }
  482.  
  483. /************************************************************************/
  484. /*    read_win local support: scan history to more recent entry    */
  485. /************************************************************************/
  486. void    scanhistorybwd( void )
  487. {
  488.     if ( histpos > history ) {
  489.         unsigned char    *found;
  490.  
  491.         *(--histpos) = 0;
  492.         found = strrchr(history, CR);
  493.         *histpos = CR;
  494.  
  495.         if ( found )
  496.             histpos = found + 1;
  497.         else
  498.             histpos = history;
  499.     }
  500. }
  501.  
  502. /************************************************************************/
  503. /*    read_win local support: search history for one older entry    */
  504. /*            beginning with first n chars as current buffer    */
  505. /************************************************************************/
  506. char    *searchfwd( int len )
  507. {
  508.     PORT    far    *p = ®2c(&port_reg)->port;
  509.     char        *entry = histpos - 1;
  510.  
  511.     while( entry && _fstrncmp(p->buffer, ++entry, len) )
  512.         entry = strchr( entry, CR );
  513.     
  514.     return entry;
  515. }
  516.  
  517. /************************************************************************/
  518. /*    read_win local support: search history for one older entry    */
  519. /*            beginning with first n chars as current buffer    */
  520. /************************************************************************/
  521. char    *searchbwd( int len )
  522. {
  523.     PORT    far    *p = ®2c(&port_reg)->port;
  524.     char        *old, *entry = histpos - 1;
  525.     int        comp = 0;
  526.  
  527.     if( histpos == history )
  528.         return NULL;
  529.  
  530.     do {
  531.         *entry = 0;
  532.         old = entry;
  533.         entry = strrchr( history, CR );
  534.         *old = CR;
  535.         comp = ( comp ? _fstrncmp(p->buffer, (entry ? entry+1 : history), len) : 1 );
  536.     } while( entry && comp != 0 );
  537.     
  538.     return ( comp ? NULL : old + 1 );
  539. }
  540.  
  541. /************************************************************************/
  542. /*    Read a "record" from window (in port_reg)            */
  543. /*                                    */
  544. /*    Return: number of characters read (including CR + 0h)        */
  545. /************************************************************************/
  546. int    read_win( void )
  547. {
  548.     PORT    far    *p;
  549.     int        tabindex = -1;    /* original index in tab search */
  550.     int        srchindex = -1;    /* original index in history search */
  551.     char        modified = 0;    /* flag */
  552.     int        key;        /* last key typed in */
  553.     REG        lcl_reg;
  554.  
  555.     p = ®2c(&port_reg)->port;    /* refresh current port properties */
  556.     curline = p->curline;
  557.     curcol = p->curcol;
  558.     ulline = p->ulline;
  559.     ulcol = p->ulcol;
  560.     nlines = p->nlines;
  561.     ncols = p->ncols;
  562.     t_attrib = p->text;
  563.     index = 0;
  564.     vidmode = -1;
  565.     histpos = history;
  566.     p->buffer[0] = CR;
  567.  
  568.     do {                /* no macro running ? */
  569.         if ( macro_reg.page == ADJPAGE(NIL_PAGE) ) {
  570.             checkbounds();
  571.             zputcur( curline + ulline, curcol + ulcol );
  572.             zcuron();
  573.             key = GETCH();
  574.             zcuroff();
  575.         } else
  576.             key = MACRO_CONTINUE;
  577.     
  578.         if ( key == NULL ) {
  579.             key = ( GETCH() << 8 );
  580.             internimm( &lcl_reg, "PCS-MACRO-KEYS" );
  581.             if ( sym_lookup( &lcl_reg, &gnv_reg ) ) {
  582.                 macro_reg.page = ADJPAGE(SPECFIX);
  583.                 macro_reg.disp = key >> 8;
  584.                 if ( eq_lookup( ¯o_reg, &lcl_reg ) ) {
  585.                     take_cdr( ¯o_reg );
  586.                     key = MACRO_CONTINUE;
  587.                 } else {
  588.                     macro_reg.page = NIL_PAGE;
  589.                     macro_reg.disp = NIL_DISP;
  590.                 }
  591.             }    
  592.         }
  593.  
  594.         if ( key != TAB )
  595.             tabindex = -1;
  596.         if ( key != UP_KEY && key != DOWN_KEY )
  597.             srchindex = -1;
  598.  
  599.         p = ®2c(&port_reg)->port;    /* reload port page */
  600.  
  601.         switch ( key ) {
  602.             case CTRL_B:
  603.             case LEFT_KEY: {
  604.                 if ( index > 0 ) index--, curcol--;
  605.                 break;
  606.             }
  607.             case CTRL_F:
  608.             case RIGHT_KEY: {
  609.                 if ( p->buffer[index] != CR ) index++, curcol++;
  610.                 break;
  611.             }
  612.             case CTRL_P:
  613.             case UP_KEY:
  614.                 if( srchindex == -1 )
  615.                     srchindex = index;
  616.             {
  617.                 char    *histfound = searchfwd( srchindex );
  618.  
  619.                 endkey();
  620.                 if ( modified ) {
  621.                     inhistory( p->buffer, index );
  622.                     modified = 0;
  623.                     if( histfound )
  624.                         histfound += index + 1;
  625.                 }
  626.                 if( histfound )
  627.                     histpos = histfound;
  628.                 else
  629.                     srchindex = -1;
  630.  
  631.                 if ( histpos != histend ) {
  632.                     backdelto( 0 );
  633.                     fromhistory();
  634.                 }
  635.                 break;
  636.             }
  637.             case CTRL_N:    
  638.             case DOWN_KEY:
  639.                 if( srchindex == -1 )
  640.                     srchindex = index;
  641.             {
  642.                 char    *histfound = searchbwd( srchindex );
  643.  
  644.                 endkey();
  645.                 if ( modified ) {
  646.                     inhistory( p->buffer, index );
  647.                     modified = 0;
  648.                     if( histfound )
  649.                         histfound += index + 1;
  650.                 }
  651.                 if( histfound )
  652.                     histpos = histfound;
  653.                 else {
  654.                     srchindex = -1;
  655.                     scanhistorybwd();
  656.                 }
  657.  
  658.                 backdelto( 0 );
  659.                 if ( histpos != history ) {
  660.                     unsigned char    *remember = histpos;
  661.  
  662.                     scanhistorybwd();
  663.                     fromhistory();
  664.                     histpos = remember;
  665.                 }
  666.                 break;
  667.             }
  668.             case ALT_B:
  669.             case CTRL_LEFT_KEY: {    /* word left */
  670.                 wordleft();
  671.                 break;
  672.             }
  673.             case ALT_F:
  674.             case CTRL_RIGHT_KEY: {    /* word right */
  675.                 wordright();
  676.                 break;
  677.             }
  678.             case CTRL_A:
  679.             case HOME_KEY: {
  680.                 homekey();
  681.                 break;
  682.             }
  683.             case CTRL_E:
  684.             case END_KEY: {
  685.                 endkey();
  686.                 break;
  687.             }
  688.             case CTRL_HOME_KEY: {    /* delete to home */
  689.                 backdelto( 0 );
  690.                 break;
  691.             }
  692.             case CTRL_K:
  693.             case ALT_K:
  694.             case CTRL_END_KEY: {     /* delete to end */
  695.                 int    pos = index;
  696.                 endkey();
  697.                 backdelto( pos );
  698.                 break;
  699.             }
  700.             case ALT_I:
  701.             case INSERT_KEY: {
  702.                 insert_m = !( insert_m );
  703.                 break;
  704.             }
  705.             case CTRL_D:
  706.             case DELETE_KEY: {
  707.                 PORT far *p = ®2c(&port_reg)->port;
  708.                 if(p->buffer[index] != CR) delkey( );
  709.                 break;
  710.             }
  711.             case BACKSPACE: {
  712.                 if ( index > 0 ) backdelto ( index - 1 );
  713.                 break;
  714.             }
  715.             case DEL: {        /* delete word left */
  716.                 int    newpos, pos = index;
  717.                 int    line = curline, col = curcol;
  718.                 wordleft();
  719.                 newpos = index;
  720.                 curcol = col, curline = line, index = pos;
  721.                 backdelto( newpos );
  722.                 break;
  723.             }
  724.             case ALT_D:
  725.             case CTRL_DEL_KEY: {    /* delete word right */
  726.                 int    pos = index;
  727.                 wordright();
  728.                 backdelto( pos );
  729.                 break;
  730.             }
  731.             case CTRL_W:
  732.             case ESCAPE: {        /* delete entry */
  733.                 modified = 0;
  734.                 endkey();
  735.                 backdelto( 0 );
  736.                 histpos = history;
  737.                 break;
  738.             }
  739.             
  740.             case ENTER_KEY:        /* grey enter key */
  741.                 key = CR;
  742.             case LF:        /* ignore LF */
  743.             case CR:        /* proceed CR later */
  744.                 break;
  745.  
  746.             case MACRO_CONTINUE: {
  747.                 unsigned char    *txt = NULL;
  748.  
  749.                 switch ( ptype[CORRPAGE(macro_reg.page)] ) {
  750.                     case LISTTYPE: {
  751.                         lcl_reg = macro_reg;
  752.                         take_car( &lcl_reg );
  753.                         take_cdr( ¯o_reg );
  754.                         txt = string_asciz( &lcl_reg );
  755.                         key = CR;
  756.                         break;
  757.                     }
  758.                     case STRTYPE:
  759.                         txt = string_asciz( ¯o_reg );
  760.                     default: {
  761.                         macro_reg.page = ADJPAGE(NIL_PAGE);
  762.                         macro_reg.disp = NIL_DISP;
  763.                     }
  764.                 }
  765.  
  766.                 if ( txt ) {
  767.                     unsigned char    *c;
  768.  
  769.                     modified = 1;
  770.                     for (c = txt; *c != 0 && *c != CR; c++) {
  771.                         putkey( *c );
  772.                         checkbounds();
  773.                     }
  774.                     rlsstr( txt );
  775.                     if ( *c == CR ) key = CR;
  776.                 }
  777.                 break;
  778.             }
  779.  
  780.             case TAB: {
  781.                 int        begindex, pos, line, col, len, i;
  782.                 unsigned char    *search, *fnd, far *c;
  783.  
  784.                 if ( tabindex >= 0 )
  785.                     while ( index > tabindex ) {
  786.                         index--, curcol--;
  787.                         checkbounds();
  788.                     }
  789.                 else tabindex = index;
  790.  
  791.                 pos = index, line = curline, col = curcol;
  792.                 wordleft();
  793.                 begindex = index;
  794.                 curcol = col, curline = line, index = pos;
  795.                 
  796.                 for ( c = &p->buffer[index]; !is_separator( *c ); c++ );
  797.                 pos = FP_OFF(c) - FP_OFF(&p->buffer[begindex]);
  798.                 search = (unsigned char *)malloc(pos + 1);
  799.                 *(search += pos) = 0;
  800.                 while ( c > &p->buffer[begindex] )
  801.                     *(--search) = *(--c);
  802.  
  803.                 len = index - begindex;    /* delete previous tab */
  804.                 pos = index;
  805.                 i = strlen(search) - len;
  806.                 while ( i-- ) {
  807.                     index++, curcol++;
  808.                     checkbounds();
  809.                 }
  810.                 backdelto( pos );
  811.  
  812.                 if ( begindex > 0 && p->buffer[begindex-1] == '"' )
  813.                 {
  814.                     fnd = ifile( search, len);
  815.                     if( fnd && p->buffer[index] == '"')
  816.                         delkey();
  817.                 } else {
  818.                     get_maxenv( &lcl_reg);
  819.                     fnd = ilookup( search, len, CORRPAGE(lcl_reg.page), lcl_reg.disp);
  820.                 }
  821.                 if ( fnd ) {
  822.                     int        old_mode = insert_m;
  823.                     unsigned char    *c;
  824.  
  825.                     modified = 1;
  826.                     backdelto( begindex );
  827.                     insert_m = 1;
  828.                     for (c = fnd; *c != 0 ; c++) {
  829.                         putkey( *c );
  830.                         checkbounds();
  831.                     }
  832.                     insert_m = old_mode;
  833.                     rlsstr(fnd);
  834.                 }
  835.                 rlsstr(search);
  836.                 break;
  837.             }
  838.  
  839.             default: if ( (key & 0xff00) == 0 ) {
  840.                 modified = 1;
  841.                 putkey( key );
  842.             }
  843.  
  844.         }
  845.     } while ( key != CR );
  846.     
  847.     matchdone();            /* wipe out local regs for GC */
  848.     endkey();
  849.     p = ®2c(&port_reg)->port;    /* reload port page */
  850.     inhistory( p->buffer, index );
  851.     curcol = 0, curline++;
  852.     checkbounds();
  853.     index++;
  854.  
  855.     if ( trns_reg.page != ADJPAGE(NIL_PAGE) && (p->winflags & W_TRANS) ) {
  856.         REG    memo;
  857.         int    pos;
  858.  
  859.         p->buffer[index] = LF;
  860.         memo = port_reg;
  861.         ssetadr( trns_reg.page, trns_reg.disp );
  862.         wrap( index );
  863.         for (pos = 0; pos <= index; pos++)
  864.             givechar( p->buffer[pos] );
  865.         ssetadr( memo.page, memo.disp );
  866.     }
  867.  
  868.     p->buffer[index] = 0;
  869.     p->curline = curline;
  870.     p->curcol = curcol;
  871.  
  872.     return index+1;
  873. }
  874.  
  875. /************************************************************************/
  876. /*    Push a string into history buffer (for %push-history opcode)    */
  877. /*                                    */
  878. /*    syntax: int pushhistory(REGPTR)                    */
  879. /*                                    */
  880. /************************************************************************/
  881. int    pushhistory(REGPTR reg)
  882. {
  883.     if ( ptype[CORRPAGE(reg->page)] == STRTYPE ) {
  884.         STRING    far    *s = ®2c(reg)->string;
  885.         int        length = s->len;
  886.         
  887.         if ( length < 0 )
  888.             length += sizeof(POINTER);
  889.         else
  890.             length -= BLK_OVHD;
  891.         if ( length < BUFFSIZE - 1 ) {
  892.             inhistory ( s->buffer, length );
  893.         }
  894.         return 0;
  895.     }
  896.     set_src_error("%PUSH-HISTORY", 1, reg);
  897.     return -1;
  898. }
  899.  
  900. /************************************************************************/
  901. /*    Get the n-th item from history (for %get-history opcode)    */
  902. /*                                    */
  903. /*    syntax: int gethistory(REGPTR)                    */
  904. /*                                    */
  905. /*    On entry, *REGPTR is a fixnum greather (or equal) than zero    */
  906. /*    On exit, *REGPTR is set to the newly allocated string        */
  907. /*                                    */
  908. /************************************************************************/
  909. int    gethistory(REGPTR reg)
  910. {
  911.     if ( reg->page == ADJPAGE(SPECFIX) ) {
  912.         unsigned char    *memo = histpos;
  913.         unsigned    num = reg->disp;
  914.  
  915.         histpos = history;
  916.         while ( num-- > 0 )
  917.             scanhistoryfwd();
  918.         if ( histpos < histend ) {
  919.             unsigned char    *beginning = histpos;
  920.  
  921.             scanhistoryfwd();
  922.             *(--histpos) = 0;    /* zeroes last CR */
  923.             alloc_string( reg, beginning );
  924.             *(histpos) = CR;
  925.         } else {
  926.             reg->page = ADJPAGE(NIL_PAGE);
  927.             reg->disp = NIL_DISP;
  928.         }
  929.         histpos = memo;
  930.         return 0;
  931.     }
  932.     set_src_error("%GET-HISTORY", 1, reg);
  933.     return -1;
  934. }
  935.  
  936.  
  937. /************************************************************************/
  938. /*    Push a single char back into the input buffer            */
  939. /************************************************************************/
  940. void    pushchar( void )
  941. {
  942.     PORT    far    *p;
  943.     
  944.     p = ®2c(&port_reg)->port;    /* reload port page */
  945.  
  946.     if ( p->bufpos > 0 ) 
  947.         p->bufpos--;
  948.     else {
  949.         zprintf("[VM INTERNAL ERROR] pushchar failed (cannot UNREAD-CHAR)\n");
  950.         force_debug();
  951.     }
  952. }
  953.